home *** CD-ROM | disk | FTP | other *** search
/ Floppyshop 2 / Floppyshop - 2.zip / Floppyshop - 2.iso / art&graf.ix / art-0039 / source / myfilese.mod < prev    next >
Text File  |  1997-04-16  |  7KB  |  256 lines
  1. IMPLEMENTATION MODULE MyFileSelector;
  2.  
  3. (*
  4.     This module will 'remember' where you were last time and
  5.     show that directory if the pathname is null. If the filename
  6.     is null then the filename of *.* is used.
  7.  
  8.     a) File Control.
  9.        These are routines that use the standard GEM file selector dialogue.
  10.        the information that is required is :-
  11.          a path name ( will get current pathname as required )
  12.          a file selection mask
  13.  
  14.        the information returned is :-
  15.          the current pathname
  16.          the file selected
  17.          a flag to indicate whether user OK'ed or 'CANCEL'led selection.
  18.      
  19.  *)
  20. (* IMPORT Trace; *)
  21. FROM SYSTEM     IMPORT ADR, ADDRESS;
  22. FROM GemDos     IMPORT Dgetdrv, Dsetdrv, Dsetpath, Dgetpath; 
  23. FROM FileSelect IMPORT fsel_input;
  24. FROM Strings       IMPORT String, Concat, Length, Assign
  25.                           Pos, PosLast, Copy, Delete;
  26.  
  27.  
  28. CONST
  29.       NULL = 0C;
  30.  
  31.         
  32. VAR
  33.     LastDrive    : ARRAY [ 0 .. 0 ] OF CHAR;
  34.         LastDir        : String;
  35.  
  36.  
  37.  
  38. PROCEDURE UpperCaseString ( VAR str : ARRAY OF CHAR );
  39.                            (* UPPER CASE a string in place *) 
  40.    VAR
  41.      i, Aa : CARDINAL;
  42.    BEGIN
  43.     FOR i := 0 TO SHORT(HIGH( str )) DO
  44.         IF  ( str[i] >= 'a' )
  45.         AND ( str[i] <= 'z' ) THEN
  46.             str[i] := CHR( ORD(str[i]) - ORD('a') + ORD('A') );
  47.         END; (* if *)
  48.     END; (* for *) 
  49.    END UpperCaseString;
  50.  
  51. (* remove trailing CR/LF from strings and compress out whitespace *)
  52.  
  53. PROCEDURE Compress( VAR s : ARRAY OF CHAR );
  54.   VAR i, out, len : INTEGER;
  55.  
  56.   PROCEDURE NextChar() : CHAR;
  57.     VAR ch : CHAR;
  58.     BEGIN
  59.       ch := 0C;
  60.       WHILE ( i < len )
  61.        AND  ( s[i] <= ' ' ) DO
  62.          INC(i);
  63.       END;
  64.       IF ( i < len ) THEN ch := s[i] END;
  65.       INC(i);
  66.       RETURN ch;  
  67.     END NextChar;
  68.  
  69.   BEGIN  (* Compress *)
  70.     len := SHORT(HIGH(s)) + 1;
  71.     i   := 0;
  72.     out := 0;
  73.  
  74.     WHILE ( out <  len ) 
  75.      AND  ( i   < len  ) DO
  76.        s[out] := NextChar();
  77.        INC(out);
  78.     END;
  79.   END Compress;  
  80.  
  81.  
  82. PROCEDURE NullFill ( VAR s : ARRAY OF CHAR );
  83.   VAR c : CARDINAL;
  84.   BEGIN
  85.     FOR c := 0 TO SHORT(HIGH(s)) DO s[c] := NULL END;
  86.   END NullFill;
  87.  
  88.  
  89. PROCEDURE  GetDefaultDrive() : CARDINAL; (* driveno *)
  90.   BEGIN
  91.     RETURN Dgetdrv();
  92.   END GetDefaultDrive;
  93.  
  94.  
  95. PROCEDURE GetDefaultPath (     DefDrive   : CARDINAL;
  96.                            VAR Pathname : ARRAY OF CHAR ); 
  97.   BEGIN
  98.     NullFill(Pathname);
  99.     Dgetpath( DefDrive, ADR(Pathname) );(* Get current directory on drive *)
  100.     Concat(Pathname,'\',Pathname);
  101.   END GetDefaultPath;
  102.  
  103.  
  104. (*-----------------------------------------------------------------------*)
  105. (* Given a complete pathname then split it up into its constituents.     *)
  106. (*    a) Drive Letter                                                    *)
  107. (*    b) Path                                                            *)
  108. (*    c) filename                                                        *)
  109. (*    d) extension                                                       *)
  110. (*-----------------------------------------------------------------------*)
  111. PROCEDURE ParseFilePath( Pathname : ARRAY OF CHAR;
  112.                  VAR Drive     : ARRAY OF CHAR;
  113.                          VAR Directory : ARRAY OF CHAR;
  114.                          VAR Filename  : ARRAY OF CHAR;
  115.                          VAR Extension : ARRAY OF CHAR );
  116.   VAR len, posn, firstslashposn, lastslashposn,
  117.       dirlen    : CARDINAL;
  118.   BEGIN
  119.     dirlen     := 0;
  120.  
  121.     NullFill(Filename); NullFill(Extension); NullFill(Directory);
  122.     NullFill(Drive);
  123.     Assign('\',Directory);
  124.  
  125.     len := Length(Pathname);
  126.     IF len = 0 THEN RETURN END;
  127.  
  128.     (* get drive *)
  129.     IF Pathname[1] = ':' THEN
  130.        Drive[0] := Pathname[0];
  131.        Delete(Pathname, 0, 2 ); (* remove used chars *)
  132.        len := Length(Pathname);
  133.        IF len = 0 THEN RETURN END;
  134.     END; 
  135.  
  136.     (* get directory *)
  137.     firstslashposn := Pos('\', Pathname, 0 );
  138.     IF firstslashposn > 0 THEN
  139.        firstslashposn := 0;
  140.     END; 
  141.     lastslashposn := PosLast('\', Pathname, len );
  142.     dirlen := (lastslashposn - firstslashposn) + 1
  143.     IF lastslashposn < len THEN
  144.        Copy(Pathname, firstslashposn, dirlen, Directory);
  145.        Delete(Pathname, firstslashposn, dirlen);
  146.     ELSE
  147.        Assign('\',Directory);
  148.     END;
  149.     len := Length(Pathname);
  150.     IF len = 0 THEN RETURN END;
  151.  
  152.     (* get filename *)
  153.     posn := PosLast('.', Pathname, len );
  154.     Copy(Pathname, 0, posn, Filename);
  155.     IF posn < len THEN
  156.        Delete(Pathname, 0, posn+1);
  157.     ELSE
  158.        Delete(Pathname, 0, posn);
  159.     END;
  160.     IF Length(Filename) > 8 THEN
  161.        Filename[8] := 0C;
  162.     END;
  163.  
  164.     len := Length(Pathname);
  165.     IF len = 0 THEN RETURN END;
  166.  
  167.     Assign(Pathname, Extension);
  168.     IF Length(Extension) > 3 THEN
  169.        Extension[3] := 0C;  
  170.     END;
  171.   END ParseFilePath;
  172.  
  173.  
  174. (* LastPath ALWAYS contains last last path to use *)
  175.  
  176. PROCEDURE GetFilename(     DefaultExtension  : ARRAY OF CHAR; 
  177.                        VAR DefaultPath       : ARRAY OF CHAR;
  178.                        VAR SelectedFilename  : ARRAY OF CHAR;
  179.                        VAR CompleteFilename  : ARRAY OF CHAR  
  180.                       ) : BOOLEAN ; (* FALSE if cancel *)
  181.  
  182.   VAR 
  183.       ExitButton    : BOOLEAN;
  184.       i         : INTEGER;
  185.       dumc          : CARDINAL;
  186.       Drive        : ARRAY [ 0 .. 0 ] OF CHAR;
  187.       Path, s1      : String;
  188.       dums, FileSel : String;
  189.   BEGIN
  190.     UpperCaseString(DefaultExtension);
  191.     Compress(DefaultExtension);
  192.     UpperCaseString(DefaultPath);
  193.     Compress(DefaultPath);
  194.     UpperCaseString(SelectedFilename);
  195.     Compress(SelectedFilename);
  196.     NullFill(CompleteFilename);
  197.  
  198.     (* get drive & path *)
  199.     ParseFilePath( DefaultPath,  Drive, Path, dums, dums );
  200.     IF Drive = 0C THEN
  201.        Assign( LastDrive, Drive);
  202.     END;
  203.     IF Length(DefaultPath) = 0 THEN
  204.        Assign(LastDir, Path);
  205.     END;
  206.     Concat(':', Path, Path);
  207.     Concat(Drive, Path, Path); (* drive + directory *)
  208.  
  209.     NullFill(s1)
  210.     Assign('*.',s1);
  211.     IF Length(DefaultExtension) <> 0 THEN
  212.        Concat(s1,DefaultExtension,s1);
  213.     ELSE
  214.        Concat(s1,'*',s1);
  215.     END; (* if *) 
  216.  
  217.     Concat(Path,s1,Path);
  218.     NullFill( FileSel );
  219.     IF  ( Length( SelectedFilename ) <= 12 )
  220.     AND ( Length( SelectedFilename ) >   0 ) THEN
  221.        Assign( SelectedFilename, FileSel );
  222.     END; (* if *)
  223.  
  224.  
  225.       (* Now use standard GEM File Selector Dialoge *)
  226.     dumc := fsel_input( Path, FileSel, ExitButton );
  227.  
  228.     (* Set up user filename with returned values *)
  229.     Assign( FileSel, SelectedFilename );
  230.  
  231.     (* get info from this select  *)
  232.     ParseFilePath( Path,  Drive, Path, dums, dums );
  233.     ParseFilePath( FileSel, dums, dums, FileSel, s1 );
  234.  
  235.     (* Set for next access *)
  236.     IF Drive <> 0C THEN
  237.        Assign( Drive, LastDrive );
  238.     END;
  239.     Assign(Path, LastDir); 
  240.     Concat(':', Path, Path);
  241.     Concat(Drive, Path, Path); (* drive + directory *)
  242.     Concat('.', s1, s1); (* Filename + Extension *)
  243.     Concat(FileSel, s1, FileSel); (* Filename + Extension *)
  244.     Concat(Path, FileSel, CompleteFilename);
  245.  
  246.     Assign(Path, DefaultPath);
  247.  
  248.     RETURN( ExitButton & (Length(FileSel) > 0) )
  249.   END GetFilename;
  250.  
  251.  
  252. BEGIN
  253.   LastDrive[0] := CHR(GetDefaultDrive() + ORD('A'));
  254.   GetDefaultPath( GetDefaultDrive(), LastDir );
  255. END MyFileSelector.
  256.